Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-04/modula2f.zip/GRAPHICS.MOD

Text File | 1992-05-01 | 4KB | 213 lines

IMPLEMENTATION MODULE Graphics;
 FROM SYSTEM IMPORT ASSEMBLER;
 FROM MathLib0 IMPORT sqrt,entier,real;
 FROM Text IMPORT WriteInt;

 PROCEDURE SetCga320();
    BEGIN
        ASM
            MOV AX,4
            INT 10H
        END;
    END SetCga320;

 PROCEDURE SetCgaMono();
    BEGIN
        ASM
            MOV AX,6
            INT 10H
        END;
    END SetCgaMono;

 PROCEDURE SetEga320();
    BEGIN
        ASM
            MOV AX,13
            INT 10H
        END;
    END SetEga320;

 PROCEDURE SetEga640();
    BEGIN
        ASM
            MOV AX,14
            INT 10H
        END;
    END SetEga640;

 PROCEDURE SetPlus();
    BEGIN
        ASM
            MOV AX,16
            INT 10H
        END;
    END SetPlus;

 PROCEDURE SetTandy();
    BEGIN
        ASM
            MOV AH,5
            MOV AL,80H
            INT 10H
            DEC BH
            DEC BL
            MOV AH,5
            MOV AL,83H
            INT 10H
            MOV AX,9
            INT 10H
        END;
    END SetTandy;

 PROCEDURE SetBackground(color:INTEGER);
    BEGIN
        color:=color MOD 16;
        ASM
            MOV AH,11
            XOR BH,BH
            MOV BL,color
            INT 10H
        END;
    END SetBackground;

 PROCEDURE Dot(color,xloc,yloc:INTEGER);
    BEGIN
        color:=color MOD 16;
        ASM
            MOV CX,xloc
            MOV DX,yloc
            MOV AL,color
            MOV AH,12
            INT 10H
        END;
    END Dot;

 PROCEDURE Box(color,x1,y1,x2,y2:INTEGER);
  VAR i:INTEGER;
  BEGIN
    IF x1>x2 THEN
        i:=x1;
        x1:=x2;
        x2:=i;
    END;
    IF y1>y2 THEN
        i:=y1;
        y1:=y2;
        y2:=i;
    END;
    ASM
        MOV AL,color
        MOV AH,12
        MOV CX,x1
        MOV DX,y1
        INT 10H
  ULOP: INC CX
        INT 10H
        CMP CX,x2
        JL ULOP
  RLOP: INC DX
        INT 10H
        CMP DX,y2
        JL RLOP
  DLOP: DEC CX
        INT 10H
        CMP CX,x1
        JG DLOP
  LLOP: DEC DX
        INT 10H
        CMP DX,y1
        JG LLOP
    END;
  END Box;

  PROCEDURE SQR(i:INTEGER):INTEGER;
    VAR a,b,d:INTEGER;

    BEGIN
        a:=i DIV 2;
        b:=(a+i DIV a) DIV 2;
        d:=b-a;
        WHILE (d > 10) OR (d < -10) DO
            a:=b;
            b:=(a+i DIV a) DIV 2;
            d:=b-a;
        END; (* while *)
        RETURN b;
    END SQR;

  PROCEDURE Circle(color,xloc,yloc,rad:INTEGER);
    VAR i,j,max:INTEGER;

    BEGIN
        max:=entier((sqrt(2.0)*real(rad))/2.0);
        FOR i:=0 TO max DO
            j:=SQR(rad*rad-i*i);
            ASM
                MOV CX,xloc
                ADD CX,i
                MOV DX,yloc
                ADD DX,j
                MOV AL,color
                MOV AH,12
                INT 10H
                SUB CX,i
                SUB CX,i
                INT 10H
                SUB DX,j
                SUB DX,j
                INT 10H
                ADD CX,i
                ADD CX,i
                INT 10H
                MOV CX,xloc
                ADD CX,j
                MOV DX,yloc
                ADD DX,i
                INT 10H
                SUB CX,j
                SUB CX,j
                INT 10H
                SUB DX,i
                SUB DX,i
                INT 10H
                ADD CX,j
                ADD CX,j
                INT 10H
            END;
         END;
    END Circle;

  PROCEDURE Look(xloc,yloc:INTEGER):INTEGER;
   VAR color:INTEGER;
   BEGIN
    color:=0;
    ASM
        MOV CX,xloc
        MOV DX,yloc
        MOV AH,13
        INT 10H
        MOV color,AL
    END;
    RETURN color
   END Look;

 PROCEDURE Clear();
  BEGIN
    ASM
        XOR BH,BH
        MOV BL,7
        MOV CX,80
        XOR DX,DX
LOP:    MOV AH,2
        INT 10H
        MOV AL,32
        MOV AH,9
        INT 10H
        INC DH
        CMP DH,25
        JNE LOP
    END;
  END Clear;

END Graphics.